home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / netstuff.zip / TSP.PAS < prev   
Pascal/Delphi Source File  |  1980-01-04  |  11KB  |  348 lines
  1. {$R+}
  2. PROGRAM traveling_salesperson ;
  3.  
  4. (* Copyright 1987 - Knowledge Garden Inc.
  5.                     473A Malden Bridge Rd.
  6.                     R.D. 2
  7.                     Nassau, NY 12123       *)
  8.  
  9.  
  10. (* TSP solves a series of differential equations which simulate a neural
  11.    net solution of the traveling salesperson problem. The problem and
  12.    the equations are described in the article "Computing with Neurons" in
  13.    the July 1987 issue of AI Expert Magazine.
  14.  
  15.    This program has been tested using Turbo ver 3.01A on an IBM PC/AT. It has
  16.    been run under both DOS 3.2 and Concurrent 5.0 .
  17.  
  18.    We would be pleased to hear your comments, good or bad, or any applications
  19.    and modifications of the program. Contact us at:
  20.  
  21.      AI Expert
  22.      500 Howard St.
  23.      San Francisco, CA 94105
  24.  
  25.    Bill and Bev Thompson    *)
  26.  
  27.  CONST
  28.   max_city = 'E' ;         (* max_city and max_position are the size of the *)
  29.   max_position = 5 ;       (* neural net. They must match. Cities run from *)
  30.                            (* A to max_city *)
  31.  
  32.   a = 500.0 ;              (* these are the weighting constants described *)
  33.   b = 500.0 ;              (* in the article. By changing then you can *)
  34.   c = 200.0 ;              (* get different types of solutions *)
  35.   d = 300.0 ;              (* d seems to have the most effect, increasing *)
  36.                            (* it produces shorter distance routes, but *)
  37.                            (* they aren't necessarily real tours. *)
  38.  
  39.   u0 = 0.02 ;              (* This parameter effects the output voltage of *)
  40.                            (* the amplifiers. Increasing it gives a broader *)
  41.                            (* curve. *)
  42.  
  43.   n = 7 ;                  (* This term affects global inhibition of the *)
  44.                            (* network. By setting it slightly larger than *)
  45.                            (* the number of cities, we seem to get better *)
  46.                            (* results *)
  47.  
  48.   h = 0.01 ;               (* The time step *)
  49.  
  50.  TYPE
  51.   cities = 'A' .. max_city ;
  52.   positions = 1 .. max_position ;
  53.  
  54.  
  55.  VAR
  56.   u : ARRAY [cities,positions] OF real ;      (* Input voltages *)
  57.   dist : ARRAY [cities,cities] OF real ;      (* Distances between cities *)
  58.  
  59.  
  60.  
  61.  FUNCTION v(city : cities ; position : positions) : real ;
  62.   (* This function calculates the output voltage from an amplifier
  63.      tanh calculates the hyperbolic tangent which gives the shape
  64.      of the output curve described in the article *)
  65.  
  66.   FUNCTION tanh(r : real) : real ;
  67.    VAR
  68.     r1,r2 : real ;
  69.    BEGIN
  70.     IF r > 20.0
  71.      THEN tanh := 1.0
  72.     ELSE IF r < -20.0
  73.      THEN tanh := -1.0
  74.     ELSE
  75.      BEGIN
  76.       r1 := exp(r) ;
  77.       r2 := exp(-r) ;
  78.       tanh := (r1 - r2) / (r1 + r2) ;
  79.      END ;
  80.    END ; (* tanh *)
  81.  
  82.   BEGIN
  83.    v := (1.0 + tanh(u[city,position] / u0)) / 2.0 ;
  84.   END ; (* v *)
  85.  
  86.  
  87.  FUNCTION f(city : cities ; position : positions) : real ;
  88.   (* This function calculates the right hand side of the differential
  89.      equations described in the article. It is not optimized for anything
  90.      and is pretty slow. *)
  91.  
  92.   FUNCTION col_sum(cty : cities) : real ;
  93.    (* column inhibition. This function helps keep the number of
  94.       output items in each column small *)
  95.    VAR
  96.     col : positions ;
  97.     sum : real ;
  98.    BEGIN
  99.     sum := 0.0 ;
  100.     FOR col := 1 TO max_position DO
  101.      IF col <> position
  102.       THEN sum := sum + v(cty,col) ;
  103.     col_sum := sum ;
  104.    END ; (* col_sum *)è
  105.   FUNCTION row_sum(p : positions) : real ;
  106.    (* row inhibition. This function helps keep the number of
  107.       output items in each row small *)
  108.    VAR
  109.     row : cities ;
  110.     sum : real ;
  111.    BEGIN
  112.     sum := 0.0 ;
  113.     FOR row := 'A' TO max_city DO
  114.      IF row <> city
  115.       THEN sum := sum + v(row,p) ;
  116.     row_sum := sum ;
  117.    END ; (* row_sum *)
  118.  
  119.   FUNCTION matrix_sum : real ;
  120.    (* global inhibition. This function keeps the total number of cities
  121.       visited small *)
  122.    VAR
  123.     row : cities ;
  124.     col : positions ;
  125.     sum : real ;
  126.    BEGIN
  127.     sum := 0.0 ;
  128.     FOR row := 'A' TO max_city DO
  129.      FOR col := 1 TO max_position DO
  130.       sum := sum + v(row,col) ;
  131.     matrix_sum := sum ;
  132.    END ; (* matrix_sum *)
  133.  
  134.   FUNCTION dist_sum : real ;
  135.    (* distance inhibition. The inhibition is larger for longer tours.
  136.       Note that neuron (X,max_position) is connected to neuron (X,1),
  137.       in other words, the net is circular *)
  138.    VAR
  139.     c : cities ;
  140.     sum : real ;
  141.    BEGIN
  142.     sum := 0.0 ;
  143.     IF position = max_position
  144.      THEN
  145.       FOR c := 'A' TO max_city DO
  146.        sum := sum + dist[city,c] * (v(c,1) + v(c,position - 1))
  147.     ELSE IF position = 1
  148.      THEN
  149.       FOR c := 'A' TO max_city DO
  150.        sum := sum + dist[city,c] * (v(c,position + 1) + v(c,max_position))
  151.     ELSE
  152.      FOR c := 'A' TO max_city DO
  153.       sum := sum + dist[city,c] * (v(c,position + 1) + v(c,position - 1)) ;
  154.     dist_sum := sum ;
  155.    END ; (* dist_sum *)
  156.  
  157.   BEGIN
  158.    f := -u[city,position] - a * col_sum(city) - b * row_sum(position)è        - c * (matrix_sum - n) - d * dist_sum ;
  159.   END ; (* f *)
  160.  
  161.  
  162.  PROCEDURE iterate ;
  163.   (* The basic solution process. This is a terrible way to solve differential
  164.      equations. Don't use it for anything serious, it performs poorly
  165.      when the number of cities gets larger than 7 or 8.
  166.      We keep iterating until the norm is less than tol or until the user
  167.      gets bored and presses the space bar. *)
  168.   CONST
  169.    tol = 1.0E-05 ;
  170.   VAR
  171.    step : integer ;
  172.    c1 : cities ;
  173.    i : positions ;
  174.    nr : real ;
  175.    u_old : ARRAY [cities,positions] OF real ;
  176.    ch : char ;
  177.  
  178.   FUNCTION norm : real ;
  179.    (* The norm is a measure of how much change there has been between
  180.       solutions. This is an infinity norm, calculated as the maximum
  181.       absolute value of the difference between components of the
  182.       solution vectors. We calculate the relative norm as:
  183.         N(u_new - u) / N(u). *)
  184.    VAR
  185.     cx : cities ;
  186.     ix : positions ;
  187.     max,max_comp : real ;
  188.    BEGIN
  189.     max := 0.0 ;
  190.     FOR cx := 'A' TO max_city DO
  191.      FOR ix := 1 TO max_position DO
  192.       BEGIN
  193.        IF abs(u_old[cx,ix] - u[cx,ix]) > max
  194.         THEN max := abs(u_old[cx,ix] - u[cx,ix]) ;
  195.        IF abs(u[cx,ix]) > max_comp
  196.         THEN max_comp := abs(u[cx,ix]) ;
  197.       END ;
  198.     norm := max / max_comp ;
  199.    END ; (* norm *)
  200.  
  201.   PROCEDURE print_matrix ;
  202.    (* Every so often, we print the input and output matrices so that
  203.       you can see what is going on. If the output matrix describes a
  204.       valid tour, we print that also. *)
  205.    VAR
  206.     c1 : cities ;
  207.     i : positions ;
  208.     vv : real ;
  209.     t : ARRAY [1 .. max_position] OF char ;
  210.     t_count : integer ;
  211.  
  212.    PROCEDURE write_tour ;è    VAR
  213.      i : positions ;
  214.      t_dist : real ;
  215.     BEGIN
  216.      t_dist := 0.0 ;
  217.      FOR i := 1 TO max_position - 1 DO
  218.       t_dist := t_dist + dist[t[i],t[i+1]] ;
  219.      t_dist := t_dist + dist[t[max_position],t[1]] ;
  220.      write(output,'Tour: ') ;
  221.      FOR i := 1 TO max_position DO
  222.       write(output,t[i]) ;
  223.      writeln(output,'   dist = ',t_dist) ;
  224.     END ; (* write_tour *)
  225.  
  226.    PROCEDURE matrix_heading ;
  227.     VAR
  228.      i : positions ;
  229.     BEGIN
  230.      write(output,'  ') ;
  231.      FOR i := 1 TO max_position DO
  232.       write(output,i : 12) ;
  233.      writeln ;
  234.     END ; (* matrix_heading *)
  235.  
  236.    BEGIN
  237.     t_count := 0 ;
  238.     FOR i := 1 TO max_position DO
  239.      t[i] := chr(0) ;
  240.     writeln(output) ;
  241.     writeln(output,'Step: ',step,' norm = ',nr) ;
  242.     writeln(output) ;
  243.     writeln(output,'Input Voltages') ;
  244.     matrix_heading ;
  245.     FOR c1 := 'A' TO max_city DO
  246.      BEGIN
  247.       write(output,c1,'    ') ;
  248.       FOR i := 1 TO max_position DO
  249.        write(output,u[c1,i] : 12 : 5) ;
  250.       writeln(output) ;
  251.      END ;
  252.     writeln(output) ;
  253.     writeln(output,'Output Voltages') ;
  254.     matrix_heading ;
  255.     FOR c1 := 'A' TO max_city DO
  256.      BEGIN
  257.       write(output,c1,'    ') ;
  258.       FOR i := 1 TO max_position DO
  259.        BEGIN
  260.         vv := v(c1,i) ;
  261.         write(output,vv : 12 : 5) ;
  262.         IF (vv > 0.8) AND (t_count < max_position) AND (t[i] = chr(0))
  263.          THEN
  264.           BEGIN
  265.            t_count := t_count + 1 ;
  266.            t[i] := c1 ;è          END ;
  267.        END ;
  268.       writeln(output) ;
  269.      END ;
  270.     IF t_count = max_position
  271.      THEN write_tour ;
  272.    END ; (* print_matrix *)
  273.  
  274.   BEGIN
  275.    step := 0 ;
  276.    REPEAT
  277.     step := step + 1 ;
  278.     move(u,u_old,sizeof(u)) ;
  279.     FOR c1 := 'A' TO max_city DO
  280.      FOR i := 1 TO max_position DO
  281.       u[c1,i] := u[c1,i] + h * f(c1,i) ;
  282.     nr := norm ;
  283.     IF ((step MOD 10) = 0) OR (step < 10)
  284.      THEN print_matrix ;
  285.    UNTIL keypressed OR (nr < tol) ;
  286.    IF keypressed
  287.     THEN read(kbd,ch) ;
  288.    print_matrix ;
  289.   END ; (* iterate *)
  290.  
  291.  
  292.  PROCEDURE initialize ;
  293.   TYPE
  294.    location = RECORD
  295.                x : real ;
  296.                y : real ;
  297.               END ;
  298.    city_array = ARRAY [cities] OF location ;
  299.   CONST
  300.    u00 = -0.01386 ;
  301. (* city_loc : city_array = ( (x : 0.21192 ; y : 0.54866),
  302.                              (x : 0.98817 ; y : 0.68465),
  303.                              (x : 0.53109 ; y : 0.72173),
  304.                              (x : 0.31459 ; y : 0.79397),
  305.                              (x : 0.63290 ; y : 0.85573)) ;
  306.  
  307.    These are the values we used for the article, if you want to
  308.    check our results, remove the comments here and use this data *)
  309.   VAR
  310.    c1,c2 : cities ;
  311.    i : positions ;
  312.    city_loc : city_array ;
  313.    ch : char ;
  314.   BEGIN
  315.    randomize ;
  316.    FOR c1 := 'A' TO max_city DO
  317.     BEGIN
  318.      city_loc[c1].x := random ;
  319.      city_loc[c1].y := random ;
  320.     END ;è   FOR c1 := 'A' TO pred(max_city) DO
  321.     BEGIN
  322.      dist[c1,c1] := 0.0 ;
  323.      FOR c2 := succ(c1) TO max_city DO
  324.       BEGIN
  325.        dist[c1,c2] := sqrt(sqr(city_loc[c1].x - city_loc[c2].x) +
  326.                            sqr(city_loc[c1].y - city_loc[c2].y)) ;
  327.        dist[c2,c1] := dist[c1,c2] ;
  328.       END ;
  329.     END ;
  330.    dist[max_city,max_city] := 0.0 ;
  331.    FOR c1 := 'A' TO max_city DO
  332.     FOR i := 1 TO max_position DO
  333.      u[c1,i] := u00 + (((2 * random - 1.0) / 10.0) * u0) ;
  334.    clrscr ;
  335.    writeln('TSP         [c] 1987 Knowledge Garden Inc.') ;
  336.    writeln('                     473A Malden Bridge Rd') ;
  337.    writeln('                     Nassau, NY 12123') ;
  338.    writeln ;
  339.    writeln('Press <Space Bar> to begin - Press again to stop iterating.') ;
  340.    read(kbd,ch) ;
  341.   END ; (* initialize *)
  342.  
  343.  
  344.  BEGIN
  345.   initialize ;
  346.   iterate ;
  347.  END.
  348.